
# Public functions

set cCreateDefaults [iarray::Array #auto \
	outputFile "" \
	mapFile "" \
	fileEncoding "" \
	translated 0 \
	transposed 1 \
	terms {} \
	\
	title "" \
	creator "" \
	paperSize Letter \
	orientation Landscape \
	\
	arrows 1 \
	wraparound 0 \
	\
	images {} \
	frame {bbox {} SeaBlue FrameBorder} \
	borders {} \
	locationTypes {} \
	locations {} \
	powerNameVariations {} \
	powers {} \
	shapes {} \
	units {} \
	colors {} \
	\
	structured 1 \
	composed 1 \
	\
	printLayout 0 \
	printPSInfo 1 \
	testBorder 0 \
	\
	addPage 1 \
	pageContents {} \
	drawAliases 1 \
	drawLayoutBorder 0 \
]
# Furthermore:
# nrOfPowers (default: length of powers list) 
# nrOfSupplies (default: length of supplies list)

set cCreateDictKeys {terms locationTypes shapes colors}

set cPaperSizes [iarray::Array #auto \
	Letter {612 792} \
	A4 {595 842} \
	A3 {842 1190} \
]

set cPageOrientations [iarray::Sequence #auto \
	Portrait Portrait \
	Seascape Landscape \
	Upside-down Portrait \
	Landscape Landscape \
]

set cLayoutBoxes [iarray::Sequence #auto \
	owners owner \
	adjustments adjustment \
	orders order \
	retreats retreat \
]

set cFileEncodings [iarray::Sequence #auto \
	western iso8859-1 \
]

set cPSFontEncodings [iarray::Sequence #auto \
	iso8859-1 ISOLatin1Encoding \
]
 
proc create {args} {
	global eSourceFiles eComposeDetails cCreateDictKeys
	
	set composing [expr ![info exists eSourceFiles]]
	set composeDetails [eval iarray::Array #auto $args]
	if {[$composeDetails has sourceFile]} {
		set sourceFile [absolve [$composeDetails of sourceFile]]
		if {!$composing} {
			assert {[lsearch $eSourceFiles $sourceFile] == -1} {
				"Recursive dependency on source file <$sourceFile>"
			}
		}
		lappend eSourceFiles $sourceFile
		source $sourceFile
		$composeDetails unset sourceFile
	}
	if {![info exists eComposeDetails]} {
		set eComposeDetails $composeDetails
	} else {
		# When merging details, most values are simply overridden,
		# except for those that are like dicts, and where order 
		# doesn't matter and non-included keys can be retained; those are 
		# merged in turn instead.
		foreach {key value} [$composeDetails get] {
			if {([lsearch $cCreateDictKeys $key] != -1) && [$eComposeDetails has $key]} {
				set keyDetails [iarray::Array #auto [$eComposeDetails of $key]]
				$keyDetails set $value
				set value [$keyDetails get]
				itcl::delete object $keyDetails
			}
			$eComposeDetails set $key $value
		}
		itcl::delete object $composeDetails
	}
	
	if {$composing} {
		set returnVal [eval compose [$eComposeDetails get]]
		itcl::delete object $eComposeDetails
		unset eComposeDetails
		if {[info exists eSourceFiles]} {
			unset eSourceFiles
		}
		return $returnVal
	}

	return {}
}

proc compose {args} {
	global cCreateDefaults cPaperSizes cPageOrientations cLayoutBoxes cFileEncodings cPSFontEncodings eDPeyeCoreDir eStandardNameLength
	
	set createDetails [iarray::Array #auto [$cCreateDefaults get]]
	eval $createDetails set $args
	
	set psFileSpec [$createDetails of outputFile]
	set mapFileSpec [$createDetails of mapFile]
	set actsFileSpec "$eDPeyeCoreDir/dpmapitacts.ps"
	
	if {[$cFileEncodings has [$createDetails of fileEncoding]]} {
		$createDetails set fileEncoding [$cFileEncodings of [$createDetails of fileEncoding]]
	}
	
	set idx [lsearch [string tolower [$cPaperSizes names]] [string tolower [$createDetails of paperSize]]]
	assert {$idx != -1} {Unrecognized paper size [$createDetails of paperSize]. Choose between: [$cPaperSizes names] }
	set paperSize [lindex [$cPaperSizes names] $idx]
	foreach {pageWidth pageHeight} [$cPaperSizes of $paperSize] {}

	if {[string is integer [$createDetails of orientation]]} {
		set pageOrientationIndex [$createDetails of orientation]
		assert {($pageOrientationIndex >= 0) && ($pageOrientationIndex <= 3)} {Page orientation should be between 0 and 3, not [$createDetails of orientation]}
	} else {
		set pageOrientationIndex [lsearch [string tolower [$cPageOrientations names]] [string tolower [$createDetails of orientation]]]
		assert {$pageOrientationIndex != -1} {Unrecognized page orientation [$createDetails of orientation]. Choose between: [$cPageOrientations names] }
	}
	set pageOrientation [lindex [$cPageOrientations names] $pageOrientationIndex]
	if {[string equal [$cPageOrientations of $pageOrientation] Landscape]} {
		set size $pageWidth
		set pageWidth $pageHeight
		set pageHeight $size
	}
	
	set actsDocument [Document #auto]
	$actsDocument autoRead [absolve $actsFileSpec]
	set acts [$actsDocument getSetup]

	set document [Document #auto]
	if {[string length [set title [$createDetails of title]]]} {
		$document updateGeneric Title "Diplomacy Map ($title)"
	} else {
		$document updateGeneric Title "Diplomacy Map"
	}
	if {[string length [set creator [$createDetails of creator]]]} {
		$document updateGeneric Creator "dpmap, using a map created with DPeye by $creator"
	} else {
		$document updateGeneric Creator "dpmap, using a map created with DPeye"
	}
	$document updateGeneric DocumentPaperSizes $paperSize
	$document updateGeneric LanguageLevel 2
	$document updateGeneric Orientation [$cPageOrientations of $pageOrientation]
	
	set infoLocations [iarray::Array #auto]
	set territoryNameMappings [iarray::Array #auto]
	set mapLocations [iarray::Array #auto]
	set mapAlternatives [iarray::Array #auto]
	set mapTranslations [iarray::Array #auto]
	set powerNameMappings [iarray::Array #auto] 
	set powerLetters [iarray::Array #auto]
	set powerTranslations [iarray::Array #auto]
	if [string length $mapFileSpec] {
		set I [MapExpect #auto -file [absolve $mapFileSpec] -nocase -white -encoding [$createDetails of fileEncoding]]
		$I expect line "^#" {
			$I continue
		} " -> (\[^=\]+) = " {
			set originalAlias [string toupper [string trim [$I get unmatched]]]
			set alias [string toupper [lindex [$I get unchecked] 0]]
			set longName [string trim [$I get match 1]]
			if {[$createDetails of translated] != 1} {
				set found 0
				if {[$createDetails of transposed]} {
					foreach {baseAlias baseInfo} [$mapTranslations get] {
						if {[string equal $originalAlias [lindex $baseInfo 0]]} {
							set found 1
							break
						}
					}
				}
				if {!$found} {
					assert {[$territoryNameMappings has $originalAlias]} {
						Translated territory alias <$originalAlias> not yet defined in map file. 
					}
					set baseAlias $originalAlias
				}
				$mapTranslations set $baseAlias [list $alias $longName]
			} else {
				assert {[$territoryNameMappings has $originalAlias]} {
					Translated territory alias <$originalAlias> not yet defined in map file. 
				}
				set alternatives [string toupper [eval list [list $longName] [lapply [$I get unchecked] {regsub -all "\\\+"} " "]]]
				if {[$createDetails of transposed]} {
					set firstAlias [lindex [$territoryNameMappings of $originalAlias] 0]
					if {[string equal $originalAlias $alias]} {
						$territoryNameMappings set $alias [list $firstAlias $longName $alternatives] 
					} else {
						assert {![$territoryNameMappings has $alias]} {
							Translated alias $alias already in use for different territory
						}
						$territoryNameMappings unset $originalAlias
						$territoryNameMappings set $alias [list $firstAlias $longName $alternatives] 
					}
				} else {
					$territoryNameMappings set $originalAlias [list $alias $longName $alternatives] 
				}
			}
			$I continue
		} " = " {
			set alias [string toupper [lindex [$I get unchecked] 0]]
			set longName [string trim [$I get unmatched]]
			set alternatives [string toupper [eval list [list $longName] [lapply [$I get unchecked] {regsub -all "\\\+"} " "]]]
			$territoryNameMappings set $alias [list $alias $longName $alternatives] 
			$I continue
		} " -> (\[^ \]+) \\\(\[^):\]*(:.*)?\\\)" {
			set originalName [string toupper [regsub "^_" [$I get unmatched] ""]]
			set name [string toupper [$I get match 1]]
			if {[string equal -length 1 "_" $name]} {
				set letter " "
				set name [string range $name 1 end]
			} else {
				set letter [string index $name 0]
			}
			switch [string length [$I get match 2]] 0 {
			} 1 {
			} 2 {
				set letter [string toupper [string index [$I get match 2] 1]]
			} default {
				assert {Letter <[$I get match 2]> for power <$name> should consist of only 1 letter}
			}
			if {[$createDetails of translated] != 1} {
				set found 0
				if {[$createDetails of transposed]} {
					foreach {baseName baseInfo} [$powerTranslations get] {
						if {[string equal $originalName [lindex $baseInfo 0]]} {
							set found 1
							break
						}
					}
				}
				if {!$found} {
					assert {[$powerNameMappings has $originalName]} {
						Translated power name <$originalName> not yet defined in map file. 
					}
					set baseName $originalName
				}
				$powerTranslations set $baseName [list $name $letter]
			} else {
				assert {[$powerNameMappings has $originalName]} {
					Translated power name <$originalName> not yet defined in map file. 
				}
				if {[$createDetails of transposed]} {
					set firstName [lindex [$powerNameMappings of $originalName] 0]
					if {[string equal $originalName $name]} {
						$powerNameMappings set $name [list $firstName $letter] 
					} else {
						assert {![$powerNameMappings has $name]} {
							Translated power name $name already in use for different power
						}
						$powerNameMappings unset $originalName
						$powerNameMappings set $name [list $firstName $letter] 
					}
				} else {
					$powerNameMappings set $originalName [list $name $letter] 
				}
			}
			$I continue
		} " \\\(\[^):\]*(:.*)?\\\)" {
			set name [string toupper [$I get unmatched]]
			if {[string equal -length 1 "_" $name]} {
				set letter " "
				set name [string range $name 1 end]
			} else {
				set letter [string index $name 0]
			}
			switch [string length [$I get match 1]] 0 {
			} 1 {
			} 2 {
				set letter [string toupper [string index [$I get match 1] 1]]
			} default {
				assert {Letter <[$I get match 1]> for power <$name> should consist of only 1 letter}
			}
			$powerNameMappings set $name [list $name $letter]
			$I continue
		} default {
			$I continue
		}
		itcl::delete object $I
		
		if {[$createDetails of transposed]} {
			foreach {alias mappingInfo} [$territoryNameMappings get] {
				$mapLocations set $alias [regsub -all "\\\+" [lindex $mappingInfo 1] ""]
				foreach name [lindex $mappingInfo 2] {
					$mapAlternatives set $name $alias
				}
			}
			foreach {name mappingInfo} [$powerNameMappings get] {
				$powerLetters set $name [lindex $mappingInfo 1]
			}
		} else {
			foreach {alias mappingInfo} [$territoryNameMappings get] {
				assert {![$mapLocations has [lindex $mappingInfo 0]]} {
					Territory alias [lindex $mappingInfo 0] already in use for different territory 
				}
				$mapLocations set [lindex $mappingInfo 0] [lindex $mappingInfo 1]
				foreach name [lindex $mappingInfo 2] {
					$mapAlternatives set $name [lindex $mappingInfo 0]
				}
			}
			foreach {name mappingInfo} [$powerNameMappings get] {
				assert {![$powerLetters has [lindex $mappingInfo 0]]} {
					Power name [lindex $mappingInfo 0] already in use for different power 
				}
				$powerLetters set [lindex $mappingInfo 0] [lindex $mappingInfo 1]
			}
		}
		
		if {[$createDetails of translated] == 2} {
			set territoryNames {}
			set powerNames {}
			if {[$createDetails of transposed]} {
				foreach {alias mappingInfo} [$mapTranslations get] {
					if {![string equal $alias [lindex $mappingInfo 0]]} {
						lappend territoryNames "[lindex $mappingInfo 0]=$alias"
					} else {
						lappend territoryNames $alias
					}
				}
				foreach {name mappingInfo} [$powerTranslations get] {
					if {![string equal $name [lindex $mappingInfo 0]]} {
						lappend powerNames "[lindex $mappingInfo 0]=$name"
					} else {
						lappend powerNames $name
					}
				}
			} else {
				foreach {alias mappingInfo} [$mapTranslations get] {
					if {![string equal $alias [lindex $mappingInfo 0]]} {
						lappend territoryNames "$alias=[lindex $mappingInfo 0]"
					} else {
						lappend territoryNames $alias
					}
				}
				foreach {name mappingInfo} [$powerTranslations get] {
					if {![string equal $name [lindex $mappingInfo 0]]} {
						lappend powerNames "$name=[lindex $mappingInfo 0]"
					} else {
						lappend powerNames $name
					}
				}
			}
			if {[llength $territoryNames]} {inform "Map territories: [Story::hexify [string toupper $territoryNames]]"}
			if {[llength $powerNames]} {inform "Map powers: [Story::hexify [string toupper $powerNames]]"}
		}
	}

	set setup [$document getSetup]
	$setup updateAttributes [$acts getAttributes]
	$setup updateAttributes "\$PageWidth $pageWidth \$PageHeight $pageHeight"
	foreach detail [$createDetails names] {
		if [string equal -length 1 $detail "\$"] {
			$setup updateAttributes [list $detail [$createDetails of $detail]]
		}
	}

	set definitions [createPlay Definitions $setup]
	set chapters [createPlay Chapters $setup define bd]
	set outlines [createPlay Outlines $setup define bd]
	set shapes [createPlay Shapes $setup define bd]
	set installations [createPlay Installations $setup]

	# General
	includePart Shorthand $definitions $acts
	includePart Math $definitions $acts
	includePart PaintOperators $definitions $acts
	if {[string length [$createDetails of fileEncoding]]} {
		includePart FindAndEncodeFont [createChapter FindAndEncodeFont $definitions \$FontEncoding [$cPSFontEncodings on [$createDetails of fileEncoding] ISOLatin1Encoding]] $acts
		$setup updateAttributes [list \$FindFont FindAndEncodeFont]
	}

	# Page setup & cleanup
	set pageSetup [createChapter PageSetup $chapters]

	switch $pageOrientationIndex 0 {
	} 1 {
		[createSketch TurnSeascape $pageSetup] setAct {
			"0 $PageWidth t"
			"-90 o"
		}
	} 2 {
		[createSketch TurnAround $pageSetup] setAct {
			"$PageWidth $PageHeight t"
			"180 o"
		}
	} 3 {
		[createSketch TurnLandscape $pageSetup] setAct {
			"$PageHeight 0 t"
			"90 o"
		}
	}
	
	set setupGState [createSketch SetupGState $pageSetup]
	$setupGState setAct {
		$InitModes
		Black
	}
	if {[$createDetails of arrows]} {
		$setupGState appendToAct MovePhase
	}
	
	set showPage [createChapter ShowPage $chapters]
	$showPage setFront {
		$FinishModes
	}
	$showPage setBack {
		showpage
	}
	if {[$createDetails of drawAliases]} {$showPage prependToAct DrawAliases}

	# Colors
	# Note that we need to overwrite define, because binding would replace all scene operators with their PaintOperators equivalent.
	set visitColors [createChapter VisitColors $chapters define def]
	$visitColors setFront {"3 dict begin" "/c xd /r xd /g xd"}
	$visitColors setBack {end}
	
	set colorTracker [ColorTracker #auto [$createDetails of colors]]
	$colorTracker readColorScenes {MapGrayColors MapRGBColors MapCMYKColors} $acts 1
	$colorTracker readColorScenes {GrayColors RGBColors CMYKColors} $acts

	# Initial gstate color
	$colorTracker addColor Black
	
	includePart DefineColors $installations $acts

	# Powers
	set powers [createAct Powers $definitions]
	$powers setAct {"/Powers 20 dict def"}
	set powerArray [iarray::code [iarray::Sequence #auto]]

	# Note that we need to overwrite define, because binding would replace all scene operators with their PaintOperators equivalent.
	set visitPowers [createChapter VisitPowers $chapters define def]
	$visitPowers setFront {"1 dict begin" "/p xd"}
	$visitPowers setBack {end}

	set powerFormat "uname ustring name name"
	set powerDictKeys {Letter Paint Contrast}
	set powerNameLength $eStandardNameLength
	set powerNameVariationLengths {}
	foreach {variation boxes} [$createDetails of powerNameVariations] {
		set nameKey [Story::toKey "$variation name"]
		lappend powerFormat ustring
		lappend powerDictKeys $nameKey
		lappend powerNameVariationLengths $eStandardNameLength
	}
	set powers [createScene Powers $visitPowers operator p format $powerFormat]
	
	# Units
	includePart MapUnitDefinitions $definitions $acts
	
	set units [iarray::Array #auto army {A army} fleet {F fleet}]
	foreach {unitName unitInfo} [$createDetails of units] {
		if {([llength $unitInfo] < 1) || ![string length [lindex $unitInfo 0]]} {
			$units unset $unitName
			continue
		}
		# Default paint method for unit is derived from unit's name.
		if {[llength $unitInfo] < 2} {
			set unitInfo [list [lindex $unitInfo 0] $unitName]
		}
		$units set $unitName $unitInfo
	}
	
	foreach unitName [$units names] {
		set drawUnit [createChapter Draw[capitalize $unitName] $chapters \
			\$StrokeUnit [valueAct StrokeControllableUnit $acts] \$FillUnit [valueAct FillUnit $acts]]
		$drawUnit setFront {
			$SwitchToMapMode
			"Power begin"
			"s t"
		}
		$drawUnit setBack {
			r
			end
		}
		includePart LocateTroop $drawUnit $acts
		includePart Paint[capitalize [lindex [$units of $unitName] 1]] $drawUnit $acts
		includePart PaintLetter $drawUnit $acts
	}
	
	itcl::delete object $units
	
	# Names
	includePart MapNameDefinitions $definitions $acts
	 
	set drawAlias [createChapter DrawAlias $chapters]
	$drawAlias setFront {
		$SwitchToMapMode
		s
		"3 1 roll t"
	}
	$drawAlias setBack r
	includePart LocateName $drawAlias $acts
	includePart PaintName $drawAlias $acts
	
	# dummy
	[createChapter DrawName $chapters] setFront {"pop pop pop"}

	# Location Types
	set locationTypes {Supplies Territories OffBoardBoxes ShapePoints}
	set locationTypeDict [iarray::Array #auto]
	foreach locationType $locationTypes {
		$locationTypeDict acquire $locationType [iarray::Array #auto]
		foreach action {visit name draw populate define} {
			set ${action}${locationType} {}
		}
	}
	foreach {locationType locationTypeInfo} [$createDetails of locationTypes] {
		if {![$locationTypeDict has $locationType]} {
			inform "Location type $locationType unknown. Ignored."
		} else {
			set idx 0
			foreach {name value} $locationTypeInfo {
				[$locationTypeDict of $locationType] set $name $value ${name}Index $idx
				incr idx
			}
		}
	}

	# Territories
	set visitTerritories [createChapter VisitTerritories $chapters \
		define def format "ustring value value" \$NumberOfScenes 0]
	$visitTerritories setFront {"$NumberOfScenes dict begin"}
	$visitTerritories setBack {end}
	createAct Operators $visitTerritories 

	# Supply centers
	set visitSupplies [createChapter VisitSupplies $chapters \
		define def format "uname value value" \$NumberOfScenes 0]
	$visitSupplies setFront {"$NumberOfScenes dict begin"}
	$visitSupplies setBack {end}
	createAct Operators $visitSupplies 

	set drawSupply [createChapter supply $chapters]
	$drawSupply setFront {
		$SwitchToMapMode
		"Power begin"
		s
		t
	}
	$drawSupply setBack {
		r
		end
	}
	includePart LocateSupply $drawSupply $acts
	includePart PaintControllableSupply $drawSupply $acts

	# Off board boxes
	if {[[$locationTypeDict of OffBoardBoxes] on name 0] || [[$locationTypeDict of OffBoardBoxes] on draw 0] || [[$locationTypeDict of OffBoardBoxes] on populate 0]} {
		set visitOffBoardBoxes [createChapter VisitOffBoardBoxes $chapters \
			define def format "ustring ustring value value" \$NumberOfScenes 0]
		$visitOffBoardBoxes setFront {"$NumberOfScenes dict begin"}
		$visitOffBoardBoxes setBack {end}
		createAct Operators $visitOffBoardBoxes 
	}

	# ShapePoints
	if {[[$locationTypeDict of ShapePoints] on name 0] || [[$locationTypeDict of ShapePoints] on draw 0]} {
		set visitShapePoints [createChapter VisitShapePoints $chapters \
			define def format "name value value" \$NumberOfScenes 0]
		$visitShapePoints setFront {"$NumberOfScenes dict begin"}
		$visitShapePoints setBack {end}
		createAct Operators $visitShapePoints
	}
	
	if {[$createDetails of arrows]} {
		
		# Order success
		includePart OkOrder [createChapter SetArrowStateOk $chapters] $acts
		[createChapter OkOrder $chapters] setAct {
			"/SetArrowState /SetArrowStateOk ld"
		}
	
		includePart FailedOrder [createChapter SetArrowStateFailed $chapters] $acts
		[createChapter FailedOrder $chapters] setAct {
			"/SetArrowState /SetArrowStateFailed ld"
		}
	
		# Phases
		set movePhase [createChapter MovePhase $chapters \$ArrowBase [valueAct ArrowMoveBase $acts]]
		$movePhase setAct {
			"/ArrowColor /$MoveColor ld"
			"/ArrowBase $ArrowBase def"
			"/TraceArrowHead /TraceSingleArrowHead ld"
			"InTextMode not { ArrowColor } if"
		}
		
		set retreatPhase [createChapter RetreatPhase $chapters \$ArrowBase [valueAct ArrowRetreatBase $acts]]
		$retreatPhase setAct {
			"/ArrowColor /$RetreatColor ld"
			"/ArrowBase $ArrowBase def"
			"/TraceArrowHead /TraceDoubleArrowHead ld"
			"InTextMode not { ArrowColor } if"
		}
		
		set proposePhase [createChapter ProposePhase $chapters \$ArrowBase [valueAct ArrowRetreatBase $acts]]
		$proposePhase setAct {
			"/ArrowColor /$ProposeColor ld"
			"/ArrowBase $ArrowBase def"
			"/TraceArrowHead /TraceDoubleArrowHead ld"
			"InTextMode not { ArrowColor } if"
		}
		
		# Arrows
		includePart TraceSingleArrowHead [createChapter TraceSingleArrowHead $chapters] $acts
		includePart TraceDoubleArrowHead [createChapter TraceDoubleArrowHead $chapters] $acts
	
		set paintArrowMove [createChapter PaintArrowMove $chapters \$ArrowBase ArrowBase]
		$paintArrowMove setFront s
		$paintArrowMove setBack r
		includePart LocateArrow $paintArrowMove $acts
		includePart ShortenArrowTail $paintArrowMove $acts
		includePart ShortenArrowTip $paintArrowMove $acts
		[createAct TraceArrowHead [alterPart PaintArrowMove {} $paintArrowMove $acts]] setAct TraceArrowHead
	
		set paintArrowCircle [createChapter PaintArrowCircle $chapters]
		$paintArrowCircle setFront {
			s 
			"5 1 roll"
		}
		$paintArrowCircle setBack r
		includePart LocateArrow $paintArrowCircle $acts
		includePart ArrowCircleBase $paintArrowCircle $acts
		includePart ShortenArrowTail $paintArrowCircle $acts
		includePart PaintArrowCircle $paintArrowCircle $acts
	
		# Arrows in blind games
		set paintArrowArrive [createChapter PaintArrowArrive $chapters \$ArrowBase ArrowBase \$ArrowRotate {180 rotate}]
		$paintArrowArrive setFront s 
		$paintArrowArrive setBack r
		includePart LocateTrailingArrow $paintArrowArrive $acts
		[createAct TraceArrowHead [alterPart PaintArrowMove {} $paintArrowArrive $acts]] setAct TraceArrowHead
		$paintArrowArrive prependToBack {
			"-5 0 m -10 0 l"
			"-15 0 m -20 0 l"
			k
		}

		set paintArrowDepart [createChapter PaintArrowDepart $chapters]
		$paintArrowDepart setFront s 
		$paintArrowDepart setBack r
		includePart LocateTrailingArrow $paintArrowDepart $acts
		includePart TraceLineShaft $paintArrowDepart $acts
		$paintArrowDepart prependToBack {
			"-6 0 m -10 0 l"
			"-16 0 m -20 0 l"
			k
		}
		
		# To wrap or not to wrap
		wrapAroundArrow [$createDetails of wraparound] $chapters $acts {
			ArrowMove
			{ArrowHold 0 {$HoldRadius PaintArrowCircle}}
			{ArrowSupport 1 {$MoveRadius PaintArrowCircle}}
			{ArrowConvoy 1 {$ConvoyRadius PaintArrowCircle}}
		}
		wrapAroundArrow 0 $chapters $acts {
			ArrowArrive
			ArrowDepart
		}
	
		# Phase shifts
		[createChapter ArrowRetreat $chapters] setAct {
			RetreatPhase
			ArrowMove
			MovePhase
		}
	
		[createChapter ArrowPropose $chapters] setAct {
			ProposePhase
			ArrowMove
			MovePhase
		}
	
		[createChapter ArrowRetreatArrive $chapters] setAct {
			RetreatPhase
			ArrowArrive
			MovePhase
		}
	
		[createChapter ArrowRetreatDepart $chapters] setAct {
			RetreatPhase
			ArrowDepart
			MovePhase
		}
	
		# Unit orders
		set buildUnit [createChapter BuildUnit $chapters]
		$buildUnit setFront {
			$SwitchToMapMode
			s
			t
			$BuildColor
		}
		$buildUnit setBack r
		includePart LocateTroop $buildUnit $acts
		includePart PaintBuildCircle $buildUnit $acts
	
		set slashUnit [createChapter SlashUnit $chapters]
		$slashUnit setFront {
			s
			"3 1 roll t"
		}
		$slashUnit setBack {
			exec
			r
		}
		includePart LocateTroop $slashUnit $acts
		includePart TraceSlash $slashUnit $acts
	
		[createChapter DestroyUnit $chapters] setAct {
			$SwitchToMapMode
			"{ $RetreatColor f } SlashUnit"
		}
		
		[createChapter DisbandUnit $chapters] setAct {
			$SwitchToMapMode
			"{ s $BuildColor f r $ArrowLineThickness w $RetreatColor k } SlashUnit"
		}
		
		[createChapter RemoveUnit $chapters] setAct {
			$SwitchToMapMode
			"{ $BuildColor f } SlashUnit"
		}
		
		# Unit orders in blind games
		set findUnit [createChapter FindUnit $chapters]
		$findUnit setFront {
			$SwitchToMapMode
			s
			t
			$DiscoverColor
		}
		$findUnit setBack r
		includePart LocateTroop $findUnit $acts
		includePart PaintBuildCircle $findUnit $acts		

		set loseUnit [createChapter LoseUnit $chapters]
		$loseUnit setFront {
			$SwitchToMapMode
			s
			t
			$DiscoverColor
		}
		$loseUnit setBack r
		includePart LocateTroop $loseUnit $acts
		includePart PaintFogWave $loseUnit $acts		

		set queryUnit [createChapter QueryUnit $chapters]
		$queryUnit setFront {
			$SwitchToMapMode
			s
			t
			$ProposeColor
		}
		$queryUnit setBack r
		includePart LocateTroop $queryUnit $acts
		includePart PaintFogWave $queryUnit $acts		

	}
	
	# Map
	set paintMap [createChapter PaintMap $chapters]
	$paintMap setFront {
		"$SwitchToMapMode"
		"s"
	}
	$paintMap setBack r

	set drawMap [createChapter DrawMap $chapters]
	$drawMap setFront PageSetup
	if {[$createDetails of drawLayoutBorder]} {$drawMap appendToFront DrawLayoutBorders}
	$drawMap appendToFront PaintMap
	
	# Drawing
	set locationShorthandDict [iarray::Array #auto {N None}]
	if [[$locationTypeDict of Supplies] on draw 0] {
		$locationShorthandDict set {S Supply}
		set drawSupplies [createChapter DrawSupplies $chapters \
			\$DrawNone "pop pop pop" \
			\$DrawSupply "supply pop" \
		]
		$drawSupplies setFront {
			"$SwitchToMapMode"
			"UNOWNEDCENTER"
		}
		$drawSupplies setBack {
			"VisitSupplies"
		}
		$drawMap appendToFront DrawSupplies
	}

	if [[$locationTypeDict of OffBoardBoxes] on draw 0] {
		$locationShorthandDict set {O OffBoard}
		set drawOffBoard [createChapter DrawOffBoard $chapters \
			\$SideRadius {$MapNameFontSize 7 mul 4 div} \
			\$CornerRadius {$MapNameFontSize 3 mul 4 div} \
		]
		$drawOffBoard setFront {
			"s"
			"t"
			"$MapNameScale $MapNameScale x"
			"$SideRadius $SideRadius $CornerRadius 0 90 a"
			"$SideRadius neg $SideRadius $CornerRadius 90 180 a"
			"$SideRadius neg $SideRadius neg $CornerRadius 180 270 a"
			"$SideRadius $SideRadius neg $CornerRadius 270 0 a"
		}
		$drawOffBoard setBack r
		set borderStrokeAct [createBorderStrokeAct $acts $colorTracker 1 0 NationalBorder]
		[createSketch Square $drawOffBoard] setAct [lindex $borderStrokeAct 0]
		$drawOffBoard prependToBack [lindex $borderStrokeAct 1]

		set drawOffBoardBoxes [createChapter DrawOffBoardBoxes $chapters \
			\$DrawNone "pop pop pop pop" \
			\$DrawOffBoard {
				DrawOffBoard pop pop
			} \
		]
		$drawOffBoardBoxes setFront {
			"$SwitchToMapMode"
			"s"
		}
		$drawOffBoardBoxes setBack {
			"VisitOffBoardBoxes"
			"r"
		}
		$drawMap appendToFront DrawOffBoardBoxes
	}

	if [[$locationTypeDict of ShapePoints] on draw 0] {
		$locationShorthandDict set {P Shape}
		set drawShapePoints [createChapter DrawShapePoints $chapters \
			\$DrawNone "pop pop pop" \
			\$DrawShape "3 2 roll load exec" \
		]
		$drawShapePoints setFront {
			"$SwitchToMapMode"
			"3 dict begin"
			"/p {lineto closepath} bd"
			"/n {} def"
			"/a {4 3 roll 2 index add 2 div 4 3 roll 2 index add 2 div 4 3 roll 2 index sub dup mul 4 3 roll 2 index sub dup mul add sqrt 0 360 arc} bd"
		}
		$drawShapePoints setBack {
			"VisitShapePoints"
			"s Black 2 w k r Yellow f"
			"end"
		}
		$colorTracker addColor Black
		$colorTracker addColor Yellow
		$drawMap appendToFront DrawShapePoints
	}

	# Populating
	if [[$locationTypeDict of Territories] on populate 0] {
		$locationShorthandDict set {A Army F Fleet AF ArmyFleet}
		switch [[$locationTypeDict of Territories] of populate] 1 {
			set drawArmyFleet \$DrawArmy
		} 2 {
			set drawArmyFleet \$DrawFleet
		} default {
			set drawArmyFleet "2 copy DrawFleet DrawArmy pop"
		}
		set populateTerritories [createChapter PopulateTerritories $chapters \
			\$DrawNone "pop pop pop" \
			\$DrawArmy "DrawArmy pop" \
			\$DrawFleet "DrawFleet pop" \
			\$DrawArmyFleet $drawArmyFleet \
		]
		$populateTerritories setFront {
			"$SwitchToMapMode"
			"s"
			"UNOWNED"
		}
		$populateTerritories setBack {
			"VisitTerritories"
			"r"
		}
		$drawMap appendToFront PopulateTerritories
	}

	if [[$locationTypeDict of OffBoardBoxes] on populate 0] {
		$locationShorthandDict set {A Army F Fleet AF ArmyFleet}
		switch [[$locationTypeDict of OffBoardBoxes] of populate] 1 {
			set drawArmyFleet \$DrawArmy
		} 2 {
			set drawArmyFleet \$DrawFleet
		} default {
			set drawArmyFleet "2 copy DrawFleet DrawArmy pop"
		}
		set populateOffBoardBoxes [createChapter PopulateOffBoardBoxes $chapters \
			\$DrawNone "pop pop pop pop" \
			\$DrawArmy "DrawArmy pop pop" \
			\$DrawFleet "DrawFleet pop pop" \
			\$DrawArmyFleet $drawArmyFleet \
		]
		$populateOffBoardBoxes setFront {
			"$SwitchToMapMode"
			"s"
		}
		$populateOffBoardBoxes setBack {
			"VisitOffBoardBoxes"
			"r"
		}
		$drawMap appendToFront PopulateOffBoardBoxes
	}
	
	# Defining
	if {[[$locationTypeDict of Supplies] on define 0]} {
		$locationShorthandDict set {S Supply}
		set defineSupplies [createPlay DefineSupplies $installations \
			\$DefineNone "pop pop pop" \
			\$DefineSupply [valueAct DefineSupply $acts] \
		]
		$defineSupplies setBack "VisitSupplies"
	}
	
	# Naming
	set drawAliases [createChapter DrawAliases $chapters]
	
	if [[$locationTypeDict of Territories] on name 0] {
		set nameTerritories [createChapter NameTerritories $chapters \
			\$DrawNone "pop pop pop" \
			\$DrawAlias {3 2 roll DrawAlias} \
		]
		$nameTerritories setFront {
			"$SwitchToMapMode"
			"s"
		}
		$nameTerritories setBack {
			"VisitTerritories"
			"r"
		}
		$drawAliases appendToFront NameTerritories
	}

	if [[$locationTypeDict of Supplies] on name 0] {
		set nameSupplies [createChapter NameSupplies $chapters \
			\$DrawNone "pop pop pop" \
			\$DrawAlias {3 2 roll 4 string cvs DrawAlias} \
		]
		$nameSupplies setFront {
			"$SwitchToMapMode"
			"s"
		}
		$nameSupplies setBack {
			"VisitSupplies"
			"r"
		}
		$drawAliases appendToFront NameSupplies
	}

	if [[$locationTypeDict of OffBoardBoxes] on name 0] {
		set nameOffBoardBoxes [createChapter NameOffBoardBoxes $chapters \
			\$DrawNone "pop pop pop pop" \
			\$DrawAlias {
				2 copy 6 5 roll DrawAlias 
				exch $MapNameOffsetX $MapNameScale mul add exch $MapNameOffsetY $MapNameScale mul add 
				3 2 roll DrawAlias
			} \
		]
		$nameOffBoardBoxes setFront {
			"$SwitchToMapMode"
			"s"
		}
		$nameOffBoardBoxes setBack {
			"VisitOffBoardBoxes"
			"r"
		}
		$drawAliases appendToFront NameOffBoardBoxes
	}

	if [[$locationTypeDict of ShapePoints] on name 0] {
		set nameShapePoints [createChapter NameShapePoints $chapters \
			\$DrawNone "pop pop pop" \
			\$DrawAlias {3 2 roll 4 string cvs DrawAlias} \
		]
		$nameShapePoints setFront {
			"$SwitchToMapMode"
			"s"
		}
		$nameShapePoints setBack {
			"VisitShapePoints"
			"r"
		}
		$drawAliases appendToFront NameShapePoints
	}
	
	# Numbering
	set numberLocations {}
	set doNumber 0
	foreach locationType [$locationTypeDict names] {
		if [[$locationTypeDict of $locationType] on number 0] {
			set doNumber 1 
			break
		}
	}
	if $doNumber {
		includePart MapNumberDefinitions $definitions $acts

		includePart PrintNumber [createChapter PrintNumber $chapters] $acts

		set numberLocations [createChapter NumberLocations $chapters]
		$numberLocations setFront {
			"$SwitchToMapMode"
			"3 dict begin"
			"/bn 1 def /en /pop ld"
			"/nr {2 index PrintNumber 1 add} bd"
			"s"
			"MapNumberFont $MapNumberScale y z"
		}
		$numberLocations setBack {r end}

		$drawMap appendToFront NumberLocations
	}

	# Complete setup

	$chapters addReference "" PageLayout MapImageScale
	
	# Images
	set nrOfSupplies 0
	set hasImage false
	set imagesDict [iarray::Array #auto]
	if {[llength [$createDetails of images]]} {
		foreach {imageName imageInfo} [$createDetails of images] {
			set imageArray [iarray::code [iarray::Sequence #auto]]
			set imageType trace
			set typeInfo {}
			assert {[llength $imageInfo]} {Need to know at least the file name for image $imageName}
			assert {[llength $imageInfo] <= 4} {Image info $imageName consists of no more than the file name, the type info, the close edge info and the image manipulations}
			foreach {imageFileSpec typeInfo closeEdgeInfo manipulations} $imageInfo {
				if {[llength $typeInfo]} {
					set infoType [lindex $typeInfo 0]
					if {[string length $infoType]} {
						set imageType $infoType
					}
					set typeInfo [lrange $typeInfo 1 end]
				}
				switch -- $imageType trace {
					eval [list readRawImage $imageArray $imageFileSpec fk] $typeInfo
					# To make reporting match the orientation of the original image, by default we mirror the image.
					if  {[llength $closeEdgeInfo]} {
						if {[llength $closeEdgeInfo] < 4} {
							foreach {nonCornerColors cornerColors edgeDistance} $closeEdgeInfo {
								set closeEdgeInfo [list $nonCornerColors $cornerColors $edgeDistance 3]
							}
						} elseif {![string length [lindex $closeEdgeInfo 3]]} {
							set closeEdgeInfo [lreplace $closeEdgeInfo 3 3 3]
						}
					}
				} scan {
					eval [list scanMap $imageArray $powerArray $imageFileSpec [$createDetails of fileEncoding] [expr [$createDetails of translated] == 2]] $typeInfo
				} default {
					assert false {Choose between trace and scan for image types for image $imageName}
				}
				if  {[llength [$imageArray names]] && [llength $closeEdgeInfo]} {
					eval closeImageEdge $imageArray $closeEdgeInfo
				}
				if {[llength $manipulations]} {
					if {[llength [$imageArray names]]} {
						eval manipulateImage $imageArray $manipulations
					}
				}
			}
			if {[llength [$imageArray names]]} {
				set hasImage true
				$imagesDict acquire $imageName $imageArray
			}
		}
		if {$hasImage} {
			set imageBBox {}
			proc expandBBox {bbox {tx 0} {ty 0}} {
				upvar imageBBox imageBBox
				if {![llength $bbox]} return
				if {![Story::isEqual $tx 0]} {
					set bbox [lreplace $bbox 0 0 [expr [lindex $bbox 0] + $tx]]
					set bbox [lreplace $bbox 2 2 [expr [lindex $bbox 2] + $tx]]
				} 
				if {![Story::isEqual $ty 0]} {
					set bbox [lreplace $bbox 1 1 [expr [lindex $bbox 1] + $ty]]
					set bbox [lreplace $bbox 3 3 [expr [lindex $bbox 3] + $ty]]
				} 
				if {[llength $imageBBox]} {
					if {[lindex $bbox 0] < [lindex $imageBBox 0]} {set imageBBox [lreplace $imageBBox 0 0 [lindex $bbox 0]]}
					if {[lindex $bbox 1] < [lindex $imageBBox 1]} {set imageBBox [lreplace $imageBBox 1 1 [lindex $bbox 1]]}
					if {[lindex $bbox 2] > [lindex $imageBBox 2]} {set imageBBox [lreplace $imageBBox 2 2 [lindex $bbox 2]]}
					if {[lindex $bbox 3] > [lindex $imageBBox 3]} {set imageBBox [lreplace $imageBBox 3 3 [lindex $bbox 3]]}
				} else {
					set imageBBox $bbox
				}
			}
		}
	}
	
	# Merge power details with powerArray
	set keepAllPowers 1
	set powerNames {}
	foreach {powerName powerInfo} [$createDetails of powers] {
		if {[string length $powerName]} {
			set keepAllPowers 0
			set powerName [string toupper $powerName]
			lappend powerNames $powerName
			if {[$powerArray has $powerName]} {
				set newInfo {}
				foreach newDetail $powerInfo detail [$powerArray of $powerName] {
					if {[string length $newDetail]} {
						lappend newInfo $newDetail
					} else {
						lappend newInfo $detail
					}
				}
				$powerArray set $powerName $newInfo
			} else {
				$powerArray set $powerName $powerInfo
			}
		} else {
			# Appending an empty name at the end ensures that all powers in the 
			# base ps-file (if used) and their order are preserved.
			set keepAllPowers 1
		}
	}
	if {!$keepAllPowers} {
		# All powers not listed are erased, and the order is adapted to match 
		# the one in createDetails.
		set idx 0
		foreach powerName $powerNames {
			$powerArray move $powerName $idx
			incr idx
		}
		foreach powerName [lrange [$powerArray names] $idx end] {
			$powerArray unset $powerName
		}
	}
	
	# Power name lengths
	foreach {powerName powerInfo} [$powerArray get] {
		assert {[llength $powerInfo] >= 3} {
			Insufficient data for power $powerName. Power should specify [Story::listKeys [lrange $powerDictKeys 0 2]].
		}
		assert {[llength $powerInfo] <= [llength $powerDictKeys]} {
			Power $powerName can at most have [llength $powerDictKeys] data, specifying [Story::listKeys $powerDictKeys].
		}
		if {[$powerTranslations has $powerName]} {
			set powerTranslation [$powerTranslations of $powerName]
			set powerName [lindex $powerTranslation 0]
			set powerInfo [lreplace $powerInfo 0 0 [lindex $powerTranslation 1]]
		}
		if {[string length $powerName] > $powerNameLength} {
			set powerNameLength [string length $powerName]
		}
		set variationLengths {}
		foreach variationName [lrange $powerInfo 3 end] nameLength $powerNameVariationLengths {
			set variationLength [string length $variationName]
			if {!$variationLength} {set variationLength [string length $powerName]}
			if {$variationLength > $nameLength} {
				lappend variationLengths $variationLength
			} else {
				lappend variationLengths $nameLength
			}
		}
		set powerNameVariationLengths $variationLengths
	}
	foreach {variation boxes} [$createDetails of powerNameVariations] nameLength $powerNameVariationLengths {
		set nameKey [Story::toKey "$variation name"]
		foreach box [string tolower $boxes] {
			assert {[$cLayoutBoxes has $box]} {
				Box name <$box> for power variation name <$variation> should be chosen from [Story::listKeys [$cLayoutBoxes names] or]. 
			}
			$createDetails set "[$cLayoutBoxes of $box]NameKey" $nameKey
			set lengthName "[$cLayoutBoxes of $box]NameLength" 
			if {[$createDetails on $lengthName 0] == 0} {
				$createDetails set $lengthName $nameLength
			}
		}
	}
	foreach box [$cLayoutBoxes names] {
		set lengthName "[$cLayoutBoxes of $box]NameLength"
		if {[$createDetails on $lengthName 0] == 0} {
			$createDetails set $lengthName $powerNameLength 
		}
	}
	
	set powerDictKeys [linsert $powerDictKeys 1 Offset]
	set added [llength $powerNameVariationLengths]
	if {$added == 0} {
		set push ""
		set pull ""
	} else {
		set push "[expr [llength $powerFormat] - 1] $added roll"
		set pull "[llength $powerDictKeys] [expr [llength $powerDictKeys] - $added] roll"
	}
	
	if {[llength [$createDetails of terms]]} {
		set cTerms [iarray::Array #auto [string tolower [$createDetails of terms]]]
		proc calcTermLength {terms} {
			upvar cTerms cTerms
			set maxTermLength 0
			foreach term $terms {
				set termLength [string length [$cTerms on $term $term]]
				if {$termLength > $maxTermLength} {set maxTermLength $termLength}
			}
			return $maxTermLength
		}
		$createDetails set orderResultLength [calcTermLength {cut bounced dislodged destroyed void "no convoy"}]
		$createDetails set retreatResultLength [calcTermLength destroyed]
		$createDetails set retreatActionLength [calcTermLength disband]
		$createDetails set adjustmentTypeLength [calcTermLength {builds removes}]
		$createDetails set adjustmentActionLength [calcTermLength waived]
		itcl::delete object $cTerms
	}
	
	[createSketch DefinePowers $installations \
		\$GetLetterOffset [valueAct GetLetterOffset $acts] \
		\$CreatePowerDict [Story::toDict $powerDictKeys] \
		\$Push $push \$Pull $pull \
		\$AddController [valueAct InsertController $acts] \
		\$InitController [valueAct InitController $acts] \
	] setAct {
		"s"
		"MapUnitLetterFont z"
		"{"
		"$Push exch load exch load"
		"2 index $GetLetterOffset 3 1 roll $Pull"
		"$CreatePowerDict"
		"[ /Power 3 2 roll { $AddController } /exec load /def load ] cvx"
		"currentdict end 3 1 roll def begin"
		"} VisitPowers"
		"r"
		"$InitController"
	}
				
	includePart Controls [createChapter Controls $chapters] $acts
	
	set centers [createScene Centers $installations operator ld format "uname uname"]
	
	# Add powers
	foreach {powerName powerInfo} [$powerArray get] {
		set powerLetter [lindex $powerInfo 0]
		if {[string equal "_" $powerLetter]} {
			set powerLetter " "
		} else {
			set powerLetter [string toupper $powerLetter]
		}
		set powerInfo [lreplace $powerInfo 0 0 $powerLetter]
		if {[$powerLetters has $powerName]} {
			if {![string equal [$powerLetters of $powerName] $powerLetter]} {
				inform "Power letter <$powerLetter> for <$powerName> is defined in map file as <[$powerLetters of $powerName]>"
			}
		} elseif {[string length $mapFileSpec] && ![llength [$powerLetters names]]} {
			inform "Power <$powerName> not defined in map file"
		}
		if {[$powerTranslations has $powerName]} {
			set powerTranslation [$powerTranslations of $powerName]
			set powerName [lindex $powerTranslation 0]
			set powerLetter [lindex $powerTranslation 1]
			set powerInfo [lreplace $powerInfo 0 0 $powerLetter]
		}
		$colorTracker addColor [lindex $powerInfo 1]
		$colorTracker addColor [lindex $powerInfo 2]
		$powers createActor [eval list [list $powerName] $powerInfo]
		$centers createActor [list ${powerName}CENTER $powerName]
	}
	if {![$powers hasActors "UNOWNED *" -nocase]} {
		$powers createActor "UNOWNED ? [$colorTracker addColor Brown] [$colorTracker addColor White]"
		$centers createActor [list UNOWNEDCENTER UNOWNED]
	}
	
	itcl::delete object $powerLetters
	itcl::delete object $powerTranslations
	itcl::delete object $powerArray
	
	# Text
	includePart TextColumnDefinitions $definitions $acts
	includePart TextHeadingDefinitions $definitions $acts
	includePart TextTitleDefinitions $definitions $acts

	includePart SplitString [createChapter SplitString $chapters] $acts

	# Layout
	set pageLayout [eval [list createPageLayout PageLayout $chapters $acts $colorTracker \
			nrOfPowers {$NrOfPowers} nrOfSupplies {$NrOfSupplies} \
			imageWidth {$MapImageWidth} imageHeight {$MapImageHeight} \
		] [$createDetails get] \
	]

	[createChapter SwitchToTextMode $pageLayout] setFront {
		"InTextMode \{"
		"FinishReport /FinishReport {} def"
		"\} \{"
		"r /InTextMode true def"
		"\} ifelse"
	}

	set switchToMapMode [createChapter SwitchToMapMode $pageLayout]
	$switchToMapMode setFront {
		"InTextMode \{"
		"FinishReport /FinishReport {} def"
		"/InTextMode false def"
		"s"
		"$ClipAndTransformToMap"
	}
	if {[$createDetails of arrows]} {
		$switchToMapMode appendToFront {
			"ArrowColor"
			"OkOrder"
		}
	}
	$switchToMapMode appendToFront {
		"\} if"
	}

	$setup updateAttributes {
		$InitModes {/FinishReport {} def /InTextMode true def}
		$FinishModes {InTextMode { FinishReport } { r } ifelse}
		$SwitchToTextMode SwitchToTextMode
		$SwitchToMapMode SwitchToMapMode
	}
	
	if {$hasImage} {
		# Locations
		set shapesDict [iarray::Array #auto]
		if {[llength [$createDetails of locations]]} {
			set shapePointsDict [iarray::Array #auto]
			foreach {locationName locationInfo} [$createDetails of locations] {
				set selectionType [lindex $locationInfo 0]
				set locationInfo [lrange $locationInfo 1 end]
				switch [lindex $selectionType 0] image {
				} default {
					lprepend locationInfo $selectionType
				}
				foreach {selections locationType operator parameters names} $locationInfo {
					if {![$locationTypeDict has $locationType]} {
						inform "Location type $locationType unknown. Location $locationName skipped."
					} else {
						set locationTypeInfo [$locationTypeDict of $locationType]
						set locations [adaptLocations names $imagesDict $selections $mapAlternatives]
						if {![llength $locations]} { 
							set locations [listLocations $imagesDict $selections]
						}
						set numbers {}
						switch -- $locationType Supplies {
							incr nrOfSupplies [llength $names]
						} ShapePoints {
							set locInfos $names
							set names {}
							foreach {number locInfo} $locInfos {
								lappend numbers $number
								lappend names $locInfo
							}
						}
						lappend parameters {}
						eval includeLocations [list [capitalize $locationName] [set visit$locationType] $operator \
							$locations $names $numbers $colorTracker $mapTranslations $locationShorthandDict] \
							[extractLocationInfo number Locations $locationTypeInfo $parameters] \
							[extractLocationInfo name $locationType $locationTypeInfo $parameters] \
							[extractLocationInfo draw $locationType $locationTypeInfo $parameters] \
							[extractLocationInfo populate $locationType $locationTypeInfo $parameters] \
							[extractLocationInfo define $locationType $locationTypeInfo $parameters] \
							[extractLocationInfo info Locations $locationTypeInfo]
						switch $locationType ShapePoints {
							$shapePointsDict set $locationName $locations
						}
					}
				}
			}
			
			# Shapes
			foreach {shapeName shapeInfo} [$createDetails of shapes] {
				defineShape $shapeName $shapeInfo $shapePointsDict $shapesDict
			}
			
			itcl::delete object $shapePointsDict
		}
		
		# Frame
		set clipAndTransform {$MapImageScale#4 dup x {$MapLeft $MapImageScale div $MapImageLeft sub}# {$MapBottom $MapImageScale div $MapImageBottom sub}# t}
		if {[llength [set frameInfo [$createDetails of frame]]]} {
			set frameType [lindex $frameInfo 0]
			set frameInfo [lrange $frameInfo 1 end]

			set drawFrame 0
			switch -- [lindex $frameType 0] "none" {
			} "bbox" {
				set drawFrame 1
			} "image" {
				set drawFrame 2
			} "shape" {
				set drawFrame 3
			} "" {
			} default {
				# Unspecified. We take it to mean an image border selection.
				set drawFrame 2
				lprepend frameInfo $frameType
			}
			if {!$drawFrame} {
				set backgroundColor ""
			} else {
				set frameDrawingScale [lindex $frameType 1]
				if {[string length $frameDrawingScale]} {
					$pageLayout updateAttributes "\$FrameScale $frameDrawingScale"
				}
									
				set selections [lindex $frameInfo 0]
				# Fill parameters: backgroundColor
				set fillParams [lindex $frameInfo 1]
				# Stroke parameters: [borderAct {{strokeColor BorderBlack} {lineWidth 1} {dashList {}} {dashInit 0} {lineCap 0} {lineJoin 0}}]*
				set strokeParams [lrange $frameInfo 2 end]

				set backgroundColor [lindex $fillParams 0]
				set frameStrokeAct {}
				if {[llength $strokeParams]} {
					set frameStrokeAct [eval createBorderStrokeAct $acts $colorTracker 1 1 $strokeParams]
				}
				
				switch -- $drawFrame 1 {
					if {[llength $frameStrokeAct]} {
						# Determine eccentricity.
						set eccentric [lrange $frameType 2 3]
						switch [llength $eccentric] 0 {
							set eccentric {0 0}
						} 1 {
							lappend eccentric [lindex $eccentric 0]
						}
						# Set the pageLayout drawing scale to $FrameScale.
						$pageLayout updateAttributes [list \
							\$MapDrawingScale \$FrameScale \$FrameEccentricWidth [lindex $eccentric 0] \$FrameEccentricHeight [lindex $eccentric 1] \
							\$FrameMarginWidth {$FrameMargin $FrameEccentricWidth add} \$FrameMarginHeight {$FrameMargin $FrameEccentricHeight add} \
						]
						set frameMap [createChapter FrameMap $pageLayout \
							\$Left {$MapLeft $FrameEccentricWidth sub} \$Right {$MapLeft $MapWidth add $FrameEccentricWidth add} \$Bottom {$MapBottom $FrameEccentricHeight sub} \$Top {$MapBottom $MapHeight add $FrameEccentricHeight add} 
						]
						foreach {frontAct fillAct execAction} $frameStrokeAct {
							set isExecutable [string length $execAction]
							$frameMap setFront s
							$frameMap setBack r
							#includePart PaintBBoxFrame $frameMap $acts
							$frameMap appendToFront $frontAct
							if {$isExecutable} {
								$frameMap appendToFront [list "\{"]
							}
							$frameMap appendToFront {
								"$Left# $Bottom# m $Right# $Bottom# l $Right# $Top# l $Left# $Top# l"
							}
							if {$isExecutable} {
								$frameMap appendToFront [list "\} $execAction"]
							}
							$frameMap appendToFront $fillAct
						}
					}
					
					set clipAndTransform [concat {
						$MapFrameLeft# $MapFrameBottom# $MapFrameWidth# $MapFrameHeight# rectclip
					} $clipAndTransform]
					if {[string length $backgroundColor]} {
						$colorTracker addColor $backgroundColor
						[createSketch PaintBackGround $paintMap] setAct [list \
							"$backgroundColor \$MapImageLeft# \$MapImageBottom# \$MapImageWidth# \$MapImageHeight# rectfill" \
						]
					}
				} 2 {
					assert {[llength $selections]} {
						A frame based on an image requires at least one selection.
					}
					includeOutline ClipMap $chapters \
						$imagesDict $outlines $selections \
						p {} {"clip n"} {} \
						1
					if {[llength $frameStrokeAct]} {
						# Set the pageLayout drawing scale to compensate for the image scale.
						$pageLayout updateAttributes {$MapDrawingScale {$FrameScale $MapImageScale div}}
						set frameStrokeAct [lreplace $frameStrokeAct 0 0 [concat [list {
							$MapImageScale#4 dup x {$MapLeft $MapImageLeft $MapImageScale mul sub $MapDrawingScale mul $FrameScale div}# {$MapBottom $MapImageBottom $MapImageScale mul sub $MapDrawingScale mul $FrameScale div}# t
						}] [lindex $frameStrokeAct 0]]]
						includeOutline FrameMap $pageLayout \
							$imagesDict $outlines $selections \
							[lindex $frameStrokeAct 1] [lindex $frameStrokeAct 0] {} [lindex $frameStrokeAct 2] \
							0
					}
					set clipAndTransform [concat $clipAndTransform ClipMap]
					if {[string length $backgroundColor]} {
						$colorTracker addColor $backgroundColor
						[createSketch PaintBackGround $paintMap] setAct [list \
							"$backgroundColor clippath fill" \
						]
					}
				} 3 {
					assert {[llength $selections]} {
						A frame based on a shape requires at least one selection.
					}
					includeFigure ClipMap $chapters \
						$shapesDict $shapes $selections \
						p {} {"clip n"} {} \
						1
					if {[llength $frameStrokeAct]} {
						# Set the pageLayout drawing scale to compensate for the image scale.
						$pageLayout updateAttributes {$MapDrawingScale {$FrameScale $MapImageScale div}}
						set frameStrokeAct [lreplace $frameStrokeAct 0 0 [concat [list \
							{$MapImageScale#4 dup x {$MapLeft $MapImageLeft $MapImageScale mul sub $MapDrawingScale mul}# {$MapBottom $MapImageBottom $MapImageScale mul sub $MapDrawingScale mul}# t} \
						] [lindex $frameStrokeAct 0]]]
						includeFigure FrameMap $pageLayout \
							$shapesDict $shapes $selections \
							[lindex $frameStrokeAct 1] [lindex $frameStrokeAct 0] {} [lindex $frameStrokeAct 2] \
							0
					}
					set clipAndTransform [concat $clipAndTransform ClipMap]
					if {[string length $backgroundColor]} {
						$colorTracker addColor $backgroundColor
						[createSketch PaintBackGround $paintMap] setAct [list \
							"$backgroundColor clippath fill" \
						]
					}
				}
				if {[llength $frameStrokeAct]} {
					$showPage appendToFront {
						FrameMap
					}
				}
			}
		}
		$pageLayout updateAttributes [list \$ClipAndTransformToMap $clipAndTransform]

		# Borders
		set paintOutlines [createAct PaintOutlines $paintMap]
		if {[$createDetails of testBorder]} {
			set testStrokeParams [list Border [list BorderBlack [$createDetails of testBorder]]]
			set testBorderStrokeAct [eval createBorderStrokeAct $acts $colorTracker 0 0 $testStrokeParams]
		}
		foreach {borderName borderInfo} [$createDetails of borders] {
			set borderType [lindex $borderInfo 0]
			set borderInfo [lrange $borderInfo 1 end]
			switch -- [lindex $borderType 0] "none" {
				set drawBorder 0
			} "bbox" {
				set drawBorder 1
			} "image" {
				set drawBorder 2
			} "shape" {
				set drawBorder 3
			} "" {
				set drawBorder 0
			} default {
				# Unspecified. We take it to mean an image border selection.
				set drawBorder 2
				lprepend borderInfo $borderType
			}
			
			switch -- $drawBorder 0 {
				continue
			} 1 {
				inform "Border of type bbox not yet implemented. Skipped."
				continue
			}
			
			set selections [lindex $borderInfo 0]
			# Fill parameters: fillColor fillLevel
			set fillParams [lindex $borderInfo 1]
			# Stroke parameters: [borderAct {{strokeColor BorderBlack} {lineWidth 1} {dashList {}} {dashInit 0} {lineCap 0} {lineJoin 0}}]*
			if {[$createDetails of testBorder]} {
				set strokeParams $testStrokeParams
			} else {
				set strokeParams [lrange $borderInfo 2 end]
			}
			
			set fillColor [lindex $fillParams 0]
			set borderTypes {{}}
			if {[string length $fillColor]} {
				if {[llength $strokeParams]} {
					set fillLevel [lindex $fillParams 1]
					if {![string length $fillLevel]} {set fillLevel 1}
					switch -- $fillLevel 0 {
						if {[$createDetails of testBorder]} {
							set borderStrokeActs [list $testBorderStrokeAct]
						} else {
							set borderStrokeActs [list [eval createBorderStrokeAct $acts $colorTracker 1 0 $strokeParams]]
						}
						$colorTracker addColor $fillColor
						lprepend borderStrokeActs [list [list $fillColor] f]
						lprepend borderTypes Fill
					} 1 {
						lprepend strokeParams Interior [list $fillColor]
						set borderStrokeActs [list [eval createBorderStrokeAct $acts $colorTracker 1 0 $strokeParams]]
					} 2 {
						# Fill on top, therefore isHalfWidth.
						if {[expr [llength $strokeParams] % 2]} {lappend strokeParams {}}
						lappend strokeParams Interior [list $fillColor]
						set borderStrokeActs [list [eval createBorderStrokeAct $acts $colorTracker 1 1 $strokeParams]]
					} 3 {
						# Fill on top, therefore isHalfWidth. Note that we can't use testBorderStrokeAct because of this.							
						$colorTracker addColor $fillColor
						set borderStrokeActs [list \
							[eval createBorderStrokeAct $acts $colorTracker 1 1 $strokeParams] \
							[list [list $fillColor] f] \
						]
						lappend borderTypes Fill
					} default {
						assert 0 {
							"Fill level <$fillLevel> not supported. Choose between 0 and 1."
						}
					}
				} else {
					$colorTracker addColor $fillColor
					set borderStrokeActs [list [list [list $fillColor] f]]
				}
			} elseif {[llength $strokeParams]} {
				if {[$createDetails of testBorder]} {
					set borderStrokeActs [list $testBorderStrokeAct]
				} else {
					set borderStrokeActs [list [eval createBorderStrokeAct $acts $colorTracker [llength $fillParams] 0 $strokeParams]]
				}
			} else {
				inform "No stroke or fill parameters for $borderName borders. Skipped."
				continue
			}
			foreach borderStrokeAct $borderStrokeActs borderType $borderTypes {
				set inclusionName Include[capitalize $borderName]$borderType
				if {$drawBorder == 3} {
					includeFigure $inclusionName $chapters \
						$shapesDict $shapes $selections \
						[lindex $borderStrokeAct 1] [lindex $borderStrokeAct 0] {} [lindex $borderStrokeAct 2] \
						0
				} else {
					includeOutline $inclusionName $chapters \
						$imagesDict $outlines $selections \
						[lindex $borderStrokeAct 1] [lindex $borderStrokeAct 0] {} [lindex $borderStrokeAct 2] \
						0
				}
				$paintOutlines appendToAct $inclusionName
			}
			
			switch $drawBorder 2 {
				foreach {imageNames colors} $selections {
					if {![llength $colors]} continue
					foreach imageName $imageNames {
						if {[$imagesDict has $imageName]} {
							set imageArray [$imagesDict of $imageName]
							foreach color $colors {
								if {[$imageArray has $color]} {
									expandBBox [[$imageArray of $color] getBBox]
								}
							}
						}
					}
				}
			}
		}
					
		# Get bbox before scaling up.
		if {![llength $imageBBox]} {
			# Last resort if the borders just consist of shapes and the like.
			foreach {imageName imageArray} [$imagesDict get] {
				foreach {color image} [$imageArray get] {
					expandBBox [$image getBBox]
					break
				} 
			}
		}
		$setup updateAttributes [list \
			\$MapImageLeft [lindex $imageBBox 0] \$MapImageBottom [lindex $imageBBox 1] \
			\$MapImageRight [lindex $imageBBox 2] \$MapImageTop [lindex $imageBBox 3] \
		]
		
		itcl::delete object $shapesDict
	}

	itcl::delete object $imagesDict
	itcl::delete object $locationTypeDict

	# Add pages
	if [$createDetails of addPage] {
		set openingPage [$document addPage Opening]
		$openingPage setFront {
			DrawMap
		}
		$openingPage setBack {
			ShowPage
		}
		if {[string length [$createDetails of pageContents]]} {
			[createAct PageContents $openingPage] setAct [$createDetails of pageContents]
		}
	}

	# Add new info to setup
	if [$createDetails has nrOfSupplies] {
		set supplyCount [$createDetails of nrOfSupplies]
	} else {
		set supplyCount $nrOfSupplies
	}
	if [$createDetails has nrOfPowers] {
		set nrOfPowers [$createDetails of nrOfPowers]
	} else {
		set nrOfPowers [expr [$powers hasActors] - [$powers hasActors "UNOWNED *" -nocase]]
	}
	$setup updateAttributes [list \
		\$NrOfPowers $nrOfPowers \
		\$NrOfSupplies $supplyCount \
	]

	# Add info on unit locations
	$document appendToDescription INFO
	set infoTranslations [iarray::Array #auto]
	set misses {}
	foreach {locName locInfo} [$infoLocations get] {
		set loc [lindex $locInfo 0]
		set locLongName [lindex $locInfo 1]
		if {![$mapLocations has $locName]} {
			if {[$mapAlternatives has $locName]} {
				inform "Primary alias used in map file for <[Story::hexify $locName]> is <[Story::hexify [$mapAlternatives of $locName]]>."
				set locName [$mapAlternatives of $locName]
			}
		}
		if {[$mapLocations has $locName]} {
			set mapLongName [$mapLocations of $locName]
			if {![string length $locLongName]} {
				set locLongName $mapLongName
			} elseif {![string equal $locLongName $mapLongName]} {
				inform "Long name for <[Story::hexify $locName]> is <[Story::hexify $mapLongName]>, not <[Story::hexify $locLongName]>."
				set locLongName $mapLongName
			}
		}
		if {[$mapTranslations has $locName]} {
			set mapTranslation [$mapTranslations of $locName]
			set locName [lindex $mapTranslation 0]
			set locLongName [lindex $mapTranslation 1]
		}
		if {![string length $locLongName]} {
			lappend misses $locName
		} else {
			$infoTranslations set $locName [list $loc $locLongName]
		}
	}
	if {[llength $misses]} {
		if {![llength [$infoTranslations names]]} {
			inform "No long names found for any location."
		} elseif {[llength $misses] == 1} {
			inform "No long name found for location [Story::hexify [lindex $misses 0]]."
		} else {
			inform "No long name found for locations [Story::hexify $misses]."						
		}
	}
	foreach locName [lsort [$infoTranslations names]] {
		set locInfo [$infoTranslations of $locName]
		set loc [lindex $locInfo 0]
		set locLongName [lindex $locInfo 1]
		$document appendToDescription [list \
			[format "%4i %4i %-6s %s" [lindex $loc 0] [lindex $loc 1] $locName $locLongName]]
	}
	itcl::delete object $infoTranslations
	itcl::delete object $infoLocations
	itcl::delete object $mapTranslations
	itcl::delete object $mapAlternatives
	itcl::delete object $mapLocations
	
	# Add language terms
	if {[llength [$createDetails of terms]]} {
		$document appendToDescription LANG
		foreach {term translation} [$createDetails of terms] {
			$document appendToDescription [list [eval list $term "=" $translation]]
		}
	}

	$document appendToDescription MAP
	
	# Add the tracked colors
	$colorTracker writeColorScenes $visitColors
			
	# Prune the variables from the setup
	set err [catch {pruneVariables $setup $chapters} msg]
	if $err {
		set errInfo $::errorInfo
		set errCode $::errorCode
		printLayout PageLayout $pageLayout
		return -errorinfo $errInfo -errorcode $errCode -code error $msg
	} elseif {[$createDetails of printLayout]} {
		printLayout PageLayout $pageLayout
	}

	set psInfo {}
	if {[string length [$createDetails of outputFile]]} {
		lappend psInfo [file rootname [$createDetails of outputFile]]
	} else {
		lappend psInfo "_"
	}
	set imageBBox [getLayoutElementBBox PageLayout $pageLayout ImageFrame]
	if {[llength $imageBBox]} {
		lappend psInfo [join $imageBBox ","]
	} else {
		lappend psInfo "_"
	}
	if {[string length [$createDetails of paperSize]] && ![string equal -nocase Letter [$createDetails of paperSize]]} {
		lappend psInfo [$createDetails of paperSize]
	} else {
		lappend psInfo "_"
	}
	if {$pageOrientationIndex != 3} {
		lappend psInfo $pageOrientationIndex
	} else {
		lappend psInfo "_"
	}
	set psInfo [regsub "((^| )_)+$" $psInfo ""]
	if {[$createDetails of printPSInfo] && [llength $psInfo]} {
			inform "PS Info: $psInfo"
	}

	if {[string length $psFileSpec]} {
		$document autoWrite [absolve $psFileSpec] encoding [$createDetails of fileEncoding] structured [$createDetails of structured] composed [$createDetails of composed]
	} else {
		inform "No output file created"
	}

	itcl::delete object $document
	itcl::delete object $actsDocument
	
	itcl::delete object $createDetails
	
	return $psInfo
}

proc pass args {}

# Private functions

# wraparound:
# 0 -> not
# 1 -> left-right wraparound
# 2 -> bottom-top wraparound
# 3 -> left-right bottom-top wraparound
# method: 
# 0 -> line between p0 and p1
# 1 -> line between p0 and center of p1 and p2
# 2 -> perpendicular line from p0 to the line between p1 and p2 (not yet implemented)
proc wrapAroundArrow {wraparound parent acts arrowParams} {
	foreach params $arrowParams {
		foreach {name method proc} [lrange $params 0 2] {
			if {![string length $name]} continue
			if {![string length $method]} {set method 0}
			if {![string length $proc]} {set proc "Paint$name"}
			
			set arrow [eval [list createChapter $name $parent] [lrange $params 3 end]]
			$arrow setFront {
				$SwitchToMapMode
				s
				SetArrowState
			}
			$arrow setBack r
		
			if {$wraparound == 0} {
				$arrow prependToBack [list $proc]
				switch $method 0 {
				} 1 {
					$arrow prependToBack center
				} default {
					assert 0 {Method $method not supported}
				}
				continue
			}
		
			switch $wraparound 1 {
				set wraparoundPrefix H
			} 2 {
				set wraparoundPrefix V
			} 3 {
				set wraparoundPrefix HV
			} default {
				assert 0 {Wraparound $wraparound not supported}
			}	
			$arrow appendToFront [list \
				"\$DoubleLine {" \
				$proc \
				"} if $proc" \
			]
			set baseMethodProc "${wraparoundPrefix}DoubleLine"
			if {$method == 0} {
				set methodProc $baseMethodProc
			} else {
				switch $method 1 {
					set methodProc "${wraparoundPrefix}DoublePointToMidLine"
				} 2 {
					set methodProc "${wraparoundPrefix}DoublePointToPerpendicularLine"
				} default {
					assert 0 {Method $method not supported}
				}
				if {![[$parent getSequence] has $baseMethodProc]} {
					$parent updateAttributes [list \$${wraparoundPrefix}DoubleLine $baseMethodProc]
					includePart $baseMethodProc [createChapter $baseMethodProc $parent] $acts
				}
			}
			$arrow updateAttributes [list \$DoubleLine $methodProc]
			if {![[$parent getSequence] has $methodProc]} {
				includePart $methodProc [createChapter $methodProc $parent] $acts
			}
		}
	}
}
